home *** CD-ROM | disk | FTP | other *** search
/ Apple Developer Connection Student Program / ADC Tools Sampler CD Disk 3 1999.iso / Cool Demos, SDKs, & Tools / Demos⁄Tools⁄Offers / Alpha ƒ / Tcl / Menus / wwwMenu.tcl < prev   
Text File  |  1999-03-18  |  25KB  |  1,005 lines
  1. ## -*-Tcl-*- (install)
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "wwwMenu.tcl"
  6.  #                                    created: 30/4/97 {11:04:46 am} 
  7.  #                                last update: 18/3/1999 {4:57:05 pm} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Copyright (c) 1997-1998  Vince Darley, all rights reserved
  15.  #  
  16.  #  A simple text-only WWW browser.  Since Alpha can't use the http
  17.  #  protocol, it can only browse files locally, but could be easily
  18.  #  extended if/when Alpha upgrades to Tcl8.0
  19.  #  
  20.  #  Basic features: handles most common html tags, and has a 
  21.  #  history list and a back/forward capability.  Can handle mailto,
  22.  #  ftp and java applets itself; all other stuff is optionally
  23.  #  shipped off to Internet Config.
  24.  #  
  25.  #  Use the cursor keys, mouse or cmd-[] to move from web page
  26.  #  to web page as follows:
  27.  #  
  28.  #    <- or cmd-[   goto previous page     
  29.  #    cmd-]         goto next page
  30.  #    -> or return  goto current link      
  31.  #    up/down arrow highlight previous/next link
  32.  #    mouse-click   goto clicked-upon link
  33.  #    
  34.  #  You can also select 'view source' from the menu.  Many keys
  35.  #  are also bound to imitate the browser 'lynx'.
  36.  #  
  37.  # Advanced features:
  38.  # 
  39.  #  ctrl-return allows you to edit the original of the link currently
  40.  #  selected.
  41.  #  
  42.  #  Using the WWW mode preferences you can ask Alpha to handle 
  43.  #  some URL types internally (currently mailto: and ftp: only).
  44.  #  Also Java applets may be sent to your javaviewer application
  45.  #  (for example the 'Apple Applet Runner' which is free from apple).
  46.  # 
  47.  # To Do:
  48.  # 
  49.  #  Could be faster (i.e. it's probably useless on 680x0 machines), 
  50.  #  and it would be nice if Alpha added Tcl's socket capability.  
  51.  #  However it's reasonably useful for browsing local HTML 
  52.  #  documentation.
  53.  # 
  54.  # Installation: (requires Alpha 7.0b1)
  55.  # 
  56.  #  It's most useful if you either make the wwwMenu a 
  57.  #  global menu (Config->Global->PackageMenus...), or if you attach a
  58.  #  key binding in your prefs.tcl to view a file; something like
  59.  #  this:
  60.  #      # Bind cmd-F12 to parse a file
  61.  #      Bind 0x6f <c> wwwParseFile
  62.  # 
  63.  # This file is copyright Vince Darley 1997, but freely distributable
  64.  # provided you note any modifications you make below.  Please send
  65.  # me bug fixes and improvements.
  66.  # ###################################################################
  67.  ##
  68.  
  69. alpha::menu wwwMenu 1.2 "global WWW HTML" "•286" {
  70.     addMode WWW wwwMenu {*.www} wwwMenu
  71.     ensureset javaviewerSig "WARZ"
  72.     set {newDocTypes(New Web Browser)} wwwParseFile
  73. } {wwwMenu} {} maintainer {
  74.     "Vince Darley" darley@fas.harvard.edu <http://www.fas.harvard.edu/~darley/>
  75. } uninstall {this-file} help {
  76.     Browse local html pages inside Alpha
  77. }
  78.  
  79. newPref v header1Color blue WWW
  80. newPref v header2Color red WWW
  81. newPref v header3Color red WWW
  82. newPref v linkColor green WWW
  83. newPref v visitedLinkColor cyan WWW
  84. newPref f mailtoLinksInternal 0 WWW
  85. newPref f ftpLinksInternal 0 WWW
  86. newPref f runJavaAppletsDirectly 0 WWW
  87. newPref f wwwSendRemoteLinks 0 WWW
  88.  
  89. # To perform a special action with a new URL type, add an array
  90. # entry indicating the procedure to be called with the remainder
  91. # of the URL.  You must also add a global variable or modeVar
  92. # as above so that the user can choose whether Alpha should handle
  93. # that type via the given procedure.  If any of this fails, the
  94. # URL is just given to Internet Config to deal with.  Note that
  95. # 'file' URL's are always handled internally.
  96. set wwwUrlAction(mailto) "mailNewMsg"
  97. set wwwUrlAction(ftp)    "ftpWWWLink"
  98. set wwwUrlAction(file)   "fileWWWLink"
  99. set wwwUrlAction(java)   "javaWWWLink"
  100. set _wwwAlwaysInternal [list file java]
  101.  
  102. proc wwwMenu {} {}
  103.  
  104. Menu -n $wwwMenu -p wwwMenuProc -M WWW {
  105.     "/S<U<OswitchToBrowser"
  106.     "(-"
  107.     "viewHtmlFile…"
  108.     "viewThisFile"
  109.     "viewSource"
  110.     "/a<S<EselectLink"
  111.     "/a<S<BmodifyLink"
  112.     "/\[back"
  113.     "/\]forward"
  114.     "reload"
  115.     {Menu -m -n gotoPage -p wwwMenuProc {
  116.     }}
  117.     "forgetHistory"
  118. }
  119.  
  120. # Bind various keys to imitate lynx.
  121.   ## 
  122.    #                         +++ Keystroke Commands    +++
  123.    #  
  124.    # MOVEMENT:      Down arrow     - Highlight next topic
  125.    #              Up arrow         - Highlight previous topic
  126.    #              Right    arrow,     - Jump    to highlighted topic
  127.    #              Return, Enter
  128.    #              Left arrow     - Return to previous topic
  129.    #         
  130.    # SCROLLING:      +                 - Scroll down to next page    (Page-Down)
  131.    #              -                 - Scroll up to    previous page (Page-Up)
  132.    #              SPACE             - Scroll down to next page    (Page-Down)
  133.    #              b                 - Scroll up to    previous page (Page-Up)
  134.    #              CTRL-A         - Go to first page    of the current document    (Home)
  135.    #              CTRL-E         - Go to last page of the current document (End)
  136.    #              CTRL-B         - Scroll up to    previous page (Page-Up)
  137.    #              CTRL-F         - Scroll down to next page    (Page-Down)
  138.    #              CTRL-N         - Go forward two lines    in the current document
  139.    #              CTRL-P         - Go back two lines in    the    current    document
  140.    #              )                 - Go forward half a page in the current document
  141.    #              (                 - Go back half    a page in the current document
  142.    ##
  143. Bind 0x7d wwwDown WWW
  144. Bind 0x7e wwwUp WWW
  145. Bind 0x7c wwwSelectLink WWW
  146. Bind 0x24 wwwSelectLink WWW
  147. Bind 0x34 wwwSelectLink WWW
  148. Bind 0x7b wwwBack WWW
  149. Bind 0x24 <z> wwwModifyLink WWW
  150. Bind 0x24 <o> wwwEditLinkedDocument WWW
  151. Bind 0x79 "wwwKey pageForward" WWW
  152. Bind 0x74 "wwwKey pageBack" WWW 
  153. Bind 0x31 "wwwKey pageForward" WWW
  154. Bind '+' "wwwKey pageForward" WWW
  155. Bind '-' "wwwKey pageBack" WWW
  156. Bind 'b' "wwwKey pageForward" WWW
  157. Bind 0x7e <c> "wwwKey Home" WWW
  158. Bind 0x7d <c> "wwwKey End" WWW
  159. Bind 'a' <z> "wwwKey Home" WWW
  160. Bind 'e' <z> "wwwKey End" WWW
  161. Bind 'b' <z> "wwwKey pageBack" WWW
  162. Bind 'f' <z> "wwwKey pageForward" WWW
  163. Bind 'n' <z> "wwwKey twoLinesForward" WWW
  164. Bind 'p' <z> "wwwKey twoLinesBack" WWW
  165. Bind ')' "wwwKey halfPageForward" WWW
  166. Bind '(' "wwwKey halfPageBack" WWW
  167.  
  168. Bind 'e' "wwwMenuProc x viewSource" WWW
  169.  
  170. Bind 'g' wwwParseFile WWW
  171. Bind 'c' wwwCopyLinkLocation WWW
  172. Bind '\t' wwwDown WWW
  173. Bind 'r' wwwReload WWW
  174.  
  175. set wwwSendRemoteLinks 0
  176.  
  177. set _wwwHistory ""
  178. set _wwwHpos -1
  179. set _wwwVisited ""
  180. set _wwwPre 0
  181.  
  182. ## 
  183.  # -------------------------------------------------------------------------
  184.  # 
  185.  # "wwwKey" --
  186.  # 
  187.  #  Handle page-movement key bindings.
  188.  # -------------------------------------------------------------------------
  189.  ##
  190. proc wwwKey {key} {
  191.     if {[set a [_wwwKeyPosition $key]] != ""} {
  192.         _wwwHighlightLink [lindex [wwwGetCurrentLink] $a]
  193.     }
  194. }
  195.  
  196. proc _wwwKeyPosition {key} {
  197.     switch $key {
  198.         "Home" {
  199.             goto [minPos]
  200.             wwwHighlightLink 0
  201.             return ""
  202.         }
  203.         "End" {
  204.             goto [maxPos]
  205.             wwwHighlightLink -1
  206.             return ""
  207.         }
  208.         "pageBack" {
  209.             pageBack
  210.             return 0
  211.         }
  212.         "pageForward" {
  213.             pageForward
  214.             return 1
  215.         }
  216.         default {
  217.             set p [getPos]
  218.             switch $key {
  219.                 "twoLinesForward" {
  220.                     scrollDownLine
  221.                     scrollDownLine
  222.                     return [_wwwEnsureOn $p]
  223.                 }
  224.                 "twoLinesBack" {
  225.                     scrollUpLine
  226.                     scrollUpLine
  227.                     return [_wwwEnsureOn $p]
  228.                 }
  229.                 "halfPageForward" {
  230.                     getWinInfo a
  231.                     set lines $a(linesdisp)
  232.                     set top $a(currline)
  233.                     set q [rowColToPos [expr $top + ${lines}/2] 0]
  234.                     goto [rowColToPos [expr $top + $lines + ($lines /2) -1] 0]
  235.                     return [_wwwEnsureOn $p 1]
  236.                 }
  237.                 "halfPageBack" {
  238.                     getWinInfo a
  239.                     set lines $a(linesdisp)
  240.                     set top $a(currline)
  241.                     set q [rowColToPos [expr $top - ${lines}/2] 0]
  242.                     goto [rowColToPos [expr $top - ${lines}/2] 0]
  243.                     return [_wwwEnsureOn $p 1]
  244.                 }
  245.             }
  246.             
  247.         }
  248.         
  249.     }
  250. }
  251.  
  252. ## 
  253.  # -------------------------------------------------------------------------
  254.  # 
  255.  # "_wwwEnsureOn" --
  256.  # 
  257.  #  Make sure pos 'p' lies in the visible window area.  If it does not,
  258.  #  goto the closest position 'q' which does.  If 'force', then 
  259.  #  provided 'p' is on-window, we goto it.  Return values indicate
  260.  #  in which direction to look for the rest of the visible window.
  261.  # -------------------------------------------------------------------------
  262.  ##
  263. proc _wwwEnsureOn {p {force 0}} {
  264.     getWinInfo a
  265.     set lines $a(linesdisp)
  266.     set top $a(currline)
  267.     set q [rowColToPos $top 0]
  268.     if {[pos::compare $q > $p]} { 
  269.         goto $q
  270.         return 1
  271.     } 
  272.     set q [pos::math [rowColToPos [expr $top + $lines] 0] - 1]
  273.     if {[pos::compare $q < $p]} {
  274.         goto $q
  275.         return 0
  276.     } 
  277.     if {$force} {
  278.         goto $p
  279.         return 0
  280.     } else {
  281.         return ""
  282.     }
  283. }
  284.                 
  285.  
  286. proc wwwMenuProc {menu item} {
  287.     if {$menu == "gotoPage"} {
  288.         # goto a history item
  289.         global _wwwHistory _wwwHpos
  290.         set pos [minPos]
  291.         foreach i $_wwwHistory {
  292.             if {[lindex $i 1] == $item} {
  293.                 break
  294.             }
  295.             incr pos
  296.         }
  297.         if {$pos >= [llength $_wwwHistory]} {
  298.             alertnote "Sorry, I couldn't find that page!"
  299.         }
  300.         set _wwwHpos $pos
  301.         eval _wwwParseFile [lindex $_wwwHistory $_wwwHpos]
  302.         _wwwHighlightLink [lindex [wwwGetCurrentLink] 1]
  303.         return
  304.     }
  305.     
  306.     switch $item {
  307.         "switchToBrowser" {
  308.             global browserSig
  309.             app::launchFore $browserSig
  310.         }
  311.         "viewHtmlFile" {
  312.             wwwParseFile [getfile "View which file"]
  313.         }
  314.         "viewThisFile" {
  315.             global mode
  316.             if {$mode == "HTML"} {
  317.                 wwwParseFile [win::Current]
  318.             } else {
  319.                 message "File must be HTML to be viewed!."
  320.                 beep
  321.             }
  322.         }
  323.         "viewSource" {
  324.             global mode
  325.             if {$mode == "WWW"} {
  326.                 global _wwwHistory _wwwHpos
  327.                 if {[catch {file::openQuietly [lindex [lindex $_wwwHistory $_wwwHpos] 0]}]} {
  328.                     alertnote "Sorry, I couldn't find that page!"
  329.                 }
  330.             }
  331.             
  332.         }
  333.         "forgetHistory" {
  334.             global _wwwHistory _wwwHpos _wwwVisited
  335.             set _wwwHistory ""
  336.             set _wwwHpos -1
  337.             set _wwwVisited ""
  338.             Menu -m -n gotoPage -p wwwMenuProc {}
  339.         }
  340.         default {
  341.             eval www[string toupper [string index $item 0]][string range $item 1 end]
  342.         }
  343.         
  344.     }
  345.     
  346. }
  347.  
  348. proc wwwParseFile {{f ""} {title ""}} {
  349.     if {$f == ""} { set f [getfile "View which file"] }
  350.     _wwwParseFile $f $title
  351.     global _wwwHistory _wwwHpos
  352.     if {[set i [lsearch -glob $_wwwHistory [list * [win::Current]]]] != -1} {
  353.         set _wwwHpos $i
  354.     } else {        
  355.         set _wwwHistory [lrange $_wwwHistory 0 $_wwwHpos]
  356.         incr _wwwHpos
  357.         lappend _wwwHistory [list $f [win::Current]]
  358.         foreach f $_wwwHistory {
  359.             lappend g [lindex $f 1]
  360.         }
  361.         Menu -m -n gotoPage -p wwwMenuProc $g
  362.     }
  363.     _wwwHighlightLink [lindex [wwwGetCurrentLink] 1]
  364.     wwwVisited $f
  365. }
  366.  
  367. proc _wwwParseFile {f {title ""}} {
  368.     if {$title != ""} {
  369.         global wwwWhere
  370.         if {[info exists wwwWhere($title)]} {
  371.             if {![catch {bringToFront $title}]} {
  372.                 return
  373.             }
  374.         }
  375.     }
  376.     if {[catch {
  377.         set fin [open $f r]
  378.         set t [read $fin]
  379.         close $fin
  380.     }]} {
  381.         catch {close $fin}
  382.         beep
  383.         alertnote "Sorry, I couldn't find and/or read that file."
  384.         error ""
  385.     }
  386.     message "Rendering…"
  387.     wwwParseText $t $f
  388.     message ""
  389. }
  390.  
  391. proc wwwParseText {t {f ""}} {
  392.     set title "no-title"
  393.     regexp -nocase {<TITLE>(.*)</TITLE>} $t dummy title
  394.     global wwwWhere
  395.     if {[info exists wwwWhere($title)]} {
  396.         if {![catch {bringToFront $title}]} {
  397.             return
  398.         } else {
  399.             wwwNewWindow $t $title
  400.             return
  401.         }
  402.     }
  403.     set "wwwWhere($title)" $f
  404.     wwwNewWindow $t $title
  405. }
  406.  
  407. proc wwwNewWindow {t title} {
  408.     set title [new -n $title -m WWW]
  409.     # ignore dirty flag and undo off.
  410.     setWinInfo shell 1
  411.     regexp -nocase {<BODY[^>]*>(.*)</BODY>} $t dummy t
  412.     catch {_wwwParseIntoWindow $t}
  413.     regsub -all {[][]} $title {\\&} title
  414.     setWinInfo read-only 1    
  415.     #setWinInfo dirty 0
  416.     goto [minPos]
  417. }
  418.  
  419. set wwwHtmlToStyle(B) bold
  420. set wwwHtmlToStyle(I) italic
  421. set wwwHtmlToStyle(U) underline
  422. set wwwHtmlToStyle(BIG) outline
  423. set wwwHtmlToStyle(SMALL) condensed
  424. set wwwHtmlToStyle(EM) italic
  425. set wwwHtmlToStyle(STRONG) bold
  426.  
  427. proc _wwwRemoveCrap {tt} {
  428.     upvar $tt t
  429.     regsub -all {alt="([^"]*)"[^>]*>} $t {>\1} t
  430.     regsub -all {<img[^>]*>} $t "" t
  431.     while {[set p [string first "<!--" $t]] != -1} {
  432.         set p2 [string first "-->" $t]
  433.         set t "[string range $t 0 [expr $p -1]][string range $t [expr $p2 + 3] end]"
  434.     }
  435.     while {[set p [string first "<FORM" $t]] != -1} {
  436.         set p2 [string first "/FORM>" $t]
  437.         set t "[string range $t 0 [expr $p -1]][string range $t [expr $p2 + 6] end]"
  438.     }        
  439. }
  440.  
  441. proc _wwwParseIntoWindow {t} {
  442.     global _wwwIndentation _wwwIndent
  443.     set _wwwIndentation 0
  444.     set _wwwIndent ""
  445.     _wwwRemoveCrap t
  446.     _wwwParseHtml $t
  447. }
  448.  
  449. proc _wwwParseHtml {t} {
  450.     global _wwwIndentation _wwwIndent
  451.     while {[regexp {^([^<]*(<[<>][^<]*)*)<([^<>][^>]*)> *(.*)$} $t dummy first dmy html t]} {
  452.         wrapInsertText $first
  453.         switch -regexp [string toupper $html] {
  454.             "^A\\s+HREF\\s*=.*" {
  455.                 set html [string range $html [expr 1+ [string first "=" $html]] end]
  456.                 if {[regexp -nocase {^([^<]*)</A>(.*)$} $t "" name t]} {
  457.                     wwwMakeLinkWord $name $html
  458.                 }
  459.             }
  460.             "^A\\s+NAME\\s*=.*" {
  461.                 set html [string range $html [expr 1+ [string first "=" $html]] end]
  462.                 set html [string trim $html " \""]
  463.                 setNamedMark $html [getPos] [getPos] [getPos]
  464.             }
  465.             "^(B|I|U|BIG|SMALL|EM|STRONG)\$" {
  466.                 if {[regexp -nocase "^(\[^<\]*)</$html>(.*)\$" $t "" name t]} {
  467.                     global wwwHtmlToStyle
  468.                     wwwMakeColourWord $name $wwwHtmlToStyle([string toupper $html]) 12
  469.                 }
  470.             }
  471.             "^/TR" {
  472.                 insertText "\r"
  473.             }
  474.             "^(UL|DL|OL|BLOCKQUOTE)" {
  475.                 _wwwNewLineIfNecessary
  476.                 incr _wwwIndentation 3
  477.                 append _wwwIndent "   "
  478.                 if {[string toupper $html] == "OL"} {
  479.                     global _wwwOLcount$_wwwIndentation
  480.                     set _wwwOLcount$_wwwIndentation 1
  481.                 }
  482.             }
  483.             "^HR" {
  484.                 _wwwBreakIfNecessary
  485.                 insertText "     ----------------------------------------------------------------     \r"
  486.             }            
  487.             "^TD" {
  488.                 #insertText " "
  489.             }
  490.             "^APPLET" {
  491.                 _wwwSplit t </APPLET> pre
  492.                 if {![regexp -nocase {code *= *([^.]*)\.class} $html dummy class]} {
  493.                     set class "applet"
  494.                 }
  495.                 wwwMakeLinkWord "Run java $class" "\"${class}.java\""
  496.             }
  497.             "^PRE" {
  498.                 global _wwwPre
  499.                 set _wwwPre 1
  500.                 #_wwwSplit t </PRE> pre
  501.                 #insertText $pre
  502.             }
  503.             "^/PRE" {
  504.                 global _wwwPre
  505.                 set _wwwPre 0
  506.             }
  507.             "^/(UL|DL|OL|BLOCKQUOTE)" {
  508.                 _wwwNewLineIfNecessary
  509.                 if {[string toupper $html] == "/OL"} {
  510.                     global _wwwOLcount$_wwwIndentation
  511.                     unset _wwwOLcount$_wwwIndentation
  512.                 }    
  513.                 incr _wwwIndentation -3
  514.                 set _wwwIndent [string range $_wwwIndent 3 end]
  515.             }
  516.             "^LI" {
  517.                 _wwwNewLineIfNecessary
  518.                 global _wwwOLcount$_wwwIndentation
  519.                 if {[info exists _wwwOLcount$_wwwIndentation]} {
  520.                     insertText "[string range ${_wwwIndent} 2 end][set _wwwOLcount$_wwwIndentation] "
  521.                     incr _wwwOLcount$_wwwIndentation
  522.                 } else {
  523.                     insertText "[string range ${_wwwIndent} 2 end]• "
  524.                 }
  525.             }
  526.             "^DT" {
  527.                 _wwwNewLineIfNecessary
  528.                 #_wwwSplit t <DD> pre
  529.                 insertText "[string range ${_wwwIndent} 2 end]"
  530.             }
  531.             "^DD" {
  532.                 insertText " "
  533.             }
  534.             "^P" {
  535.                 _wwwBreakIfNecessary
  536.                 set t [string trimleft $t]
  537.             }
  538.             "^BR( .*)?" {
  539.                 if {[lindex [posToRowCol [getPos]] 1] != 0} {
  540.                     insertText "\r"
  541.                 }
  542.                 set t [string trimleft $t]
  543.             }
  544.             "^H\[0-9\]" {
  545.                 set html [lindex $html 0]
  546.                 set num [string range $html 1 end]
  547.                 _wwwBreakIfNecessary
  548.                 if {[regexp -nocase "^(\[^<\]*)</$html>(.*)\$" $t dummy name t]} {
  549.                     switch $num {
  550.                         1 {
  551.                             insertText "\r"
  552.                             global header1Color
  553.                             wwwMakeColourWord $name $header1Color 0 outline
  554.          
  555.                         }
  556.                         2 {
  557.                             global header2Color
  558.                             wwwMakeColourWord $name $header2Color 0 bold
  559.                         }
  560.                         default {
  561.                             global header3Color
  562.                             wwwMakeColourWord $name $header3Color 0
  563.                         }
  564.                     }
  565.                 } 
  566.                 insertText "\r\r"
  567.             }
  568.             "^COMMENT" {
  569.                 _wwwSplit t </COMMENT> pre
  570.             }
  571.             "^EMBED\\s+" {
  572.                 if {[regexp -nocase {src *= *"([^"]+)"} $html dummy embed]} {
  573.                     set name "???"
  574.                     regexp {[^/:]+$} $embed name
  575.                     wwwMakeLinkWord "Embedded '$name'." $embed
  576.                 }
  577.             }
  578.             "^/.*" {
  579.             }
  580.             default {
  581.                 set html [lindex $html 0]
  582.                 if {[regexp -nocase "^(\[^<\]*)</$html>(.*)\$" $t dummy name t]} {
  583.                     wrapInsertText $name
  584.                 }
  585.             }
  586.         }
  587.     }
  588.     wrapInsertText $t
  589. }
  590.  
  591. proc _wwwBreakIfNecessary {} {
  592.     if {[lookAt [pos::math [getPos] - 1]] != "\r"} {
  593.         insertText "\r"
  594.     }
  595.     if {[lookAt [pos::math [getPos] - 2]] != "\r"} {
  596.         insertText "\r"
  597.     }
  598. }
  599. proc _wwwNewLineIfNecessary {} {
  600.     if {[lookAt [pos::math [getPos] - 1]] != "\r"} {insertText "\r"}
  601. }
  602.  
  603. proc _wwwSplit {text at prefix} {
  604.     upvar $prefix a
  605.     upvar $text t
  606.     if {[set p [string first $at [string toupper $t]]] == -1} {
  607.         set a $t
  608.         set t ""
  609.     } else {
  610.         set a [string range $t 0 [expr $p -1]]
  611.         set t [string range $t [expr $p + [string length $at]] end]
  612.     }
  613. }
  614.     
  615. proc wrapInsertText {text} {
  616.     global _wwwPre
  617.     if {!$_wwwPre} {
  618.         regsub -all "\[\t\r\n \]+" [string trim $text] " " text
  619.     }
  620.     regsub -all " " $text " " text
  621.     regsub -all "&" $text {\&} text
  622.     regsub -all "<" $text "<" text
  623.     regsub -all ">" $text ">" text
  624.     regsub -all """ $text {"} text
  625.     if {$_wwwPre} {
  626.         insertText $text
  627.         return
  628.     }
  629.     if {$text == ""} { return }
  630.     set r [posToRowCol [getPos]]
  631.     set x [lindex $r 1]
  632.     global _wwwIndentation _wwwIndent
  633.     if {$x > 74} {
  634.         insertText "\r$_wwwIndent"
  635.         set x 0
  636.     }
  637.     if {$x == 0} { 
  638.         incr x $_wwwIndentation 
  639.     } else {
  640.         if {[regexp {^\w} $text]} {
  641.             if {[regexp {\w} [lookAt [pos::math [getPos] - 1]]]} {
  642.                 insertText " "
  643.                 incr x
  644.             }
  645.         }
  646.     }
  647.     set fc [expr 75 - $x]
  648.     while {[string length $text] > $fc} {
  649.         set f [string last " " [string range $text 0 $fc]]
  650.         if {$f == -1} {
  651.             set f $fc
  652.         }
  653.         insertText "[string range $text 0 $f]\r$_wwwIndent"
  654.         set text [string range $text [incr f] end]
  655.         set fc [expr 75 - $_wwwIndentation]
  656.     }
  657.     insertText $text
  658. }
  659.  
  660. proc wwwMakeColourWord {word ind ind2 {with ""}} {
  661.     wwwDoColour $ind $with
  662.     wrapInsertText $word
  663.     wwwDoColour $ind2 12
  664. }
  665.  
  666. proc wwwDoColour {ind {with ""}} {
  667.     set p [getPos]
  668.     insertColorEscape $p $ind
  669.     if {$with != ""} {
  670.         insertColorEscape $p $with
  671.     }
  672. }
  673.  
  674. proc wwwMakeColour {from to ind ind2} {
  675.     insertColorEscape $from $ind
  676.     insertColorEscape $to $ind2    
  677. }
  678.  
  679. proc wwwMakeLinkWord {word link} {
  680.     if {$word == ""} { return }
  681.     set p [getPos]
  682.     if {[regexp {\w} [lookAt [pos::math $p - 1]]]} {
  683.         insertText " "
  684.         set p [pos::math $p + 1]
  685.     }
  686.     set cmd "wwwLink [set link [string trim $link]]"
  687.     insertColorEscape $p [_wwwLinkColour $link]
  688.     insertColorEscape $p 15 $cmd    
  689.     wrapInsertText $word
  690.     set p [getPos]
  691.     insertColorEscape $p 12
  692.     insertColorEscape $p 0
  693. }
  694.  
  695. proc _wwwLinkColour {link} {
  696.     global linkColor visitedLinkColor _wwwVisited
  697.     if {[lsearch -exact $_wwwVisited [string trim $link {"}]] == -1} {
  698.         return $linkColor
  699.     } else {
  700.         return $visitedLinkColor
  701.     }
  702. }
  703.  
  704. proc wwwMakeLink {from to link} {
  705.     set cmd "wwwLink [set link [string trim $link]]"
  706.     insertColorEscape $from [_wwwLinkColour $link]
  707.     insertColorEscape $from 15 $cmd
  708.     insertColorEscape $to 12
  709.     insertColorEscape $to 0
  710. }
  711.  
  712. proc _wwwSynchroniseHistoryPos {} {
  713.     global _wwwHistory _wwwHpos
  714.     set w [win::Current]
  715.     regsub -all {[][]} $w {\\&} w
  716.     set _wwwHpos [lsearch -glob $_wwwHistory [list * $w]]
  717.     #set _wwwHistory [lrange $_wwwHistory 0 $_wwwHpos]    
  718. }
  719.  
  720. proc wwwVisited {to} {
  721.     global _wwwVisited
  722.     if {[lsearch -exact $_wwwVisited $to] == -1} {
  723.         lappend _wwwVisited $to
  724.     }
  725. }
  726.  
  727. proc wwwLink {to} {
  728.     wwwVisited $to
  729.     _wwwSynchroniseHistoryPos
  730.     if {[set l [string first ":" $to]] == -1} {
  731.         # it's local
  732.         _wwwSplit to "\#" pre
  733.         if {[string length $pre]} {
  734.             global wwwWhere
  735.             switch [file extension $pre] {
  736.                 ".class" - 
  737.                 ".java" {
  738.                     set pref "java"
  739.                 }
  740.                 default {
  741.                     set pref "file"
  742.                 }
  743.             }            
  744.             wwwLink "${pref}://[file dirname $wwwWhere([win::Current])]/$pre"
  745.         }
  746.         gotoMark $to
  747.         _wwwHighlightLink [lindex [wwwGetCurrentLink] 1]
  748.         return
  749.     }
  750.     set p [string trimleft [string range $to [expr $l +1] end] "/"]
  751.     set urlType [string range $to 0 [expr $l -1]]
  752.     global wwwUrlAction
  753.     if {[info exists wwwUrlAction($urlType)]} {
  754.         # do we handle this internally
  755.         global ${urlType}LinksInternal
  756.         global _wwwAlwaysInternal
  757.         if {[lsearch -exact $_wwwAlwaysInternal $urlType] != -1 \
  758.             || ([info exists ${urlType}LinksInternal] \
  759.             && [set ${urlType}LinksInternal]) } {
  760.             
  761.             $wwwUrlAction($urlType) $p
  762.             return
  763.         }
  764.     }
  765.     # if we didn't return above
  766.     wwwExternalLink $to
  767. }
  768.  
  769. proc _wwwMassagePath {pp} {
  770.     upvar $pp p
  771.     regsub -all "/" $p ":" p
  772.     regsub -all {[^:]+:\.\.:} $p "" p
  773. }
  774.  
  775. proc fileWWWLink {p} {
  776.     _wwwMassagePath p
  777.     global ModeSuffixes
  778.     if {[case [file extension $p] $ModeSuffixes] == "HTML"} {
  779.         wwwParseFile $p
  780.     } else {
  781.         file::openQuietly $p
  782.     }
  783. }
  784.  
  785. proc javaWWWLink {p} {
  786.     global runJavaAppletsDirectly
  787.     if {$runJavaAppletsDirectly} {
  788.         # can run applet directly
  789.         _wwwMassagePath p
  790.         alertnote "Sorry, I don't yet know how to run .class files directly."
  791.         javaRun "[file root ${p}].class"
  792.     } else {
  793.         # use html file
  794.         global javaviewerSig _wwwHistory _wwwHpos
  795.         set app [file tail [app::launchFore $javaviewerSig]]
  796.         sendOpenEvent -n $app [lindex [lindex $_wwwHistory $_wwwHpos] 0]
  797.     }
  798. }
  799.  
  800. proc ftpWWWLink {p} {
  801.     url::parseFtp $p i
  802.     ftpBrowse $i(host) $i(path) $i(user) $i(pass) $i(file)
  803. }
  804.  
  805. proc wwwExternalLink {to} {
  806.     global wwwSendRemoteLinks
  807.     if {$wwwSendRemoteLinks} {
  808.         icURL $to
  809.     } else {
  810.         alertnote "External link to $to, toggle this mode's flags to use a helper instead of this message."
  811.     }
  812. }
  813.  
  814. proc wwwForward {} {
  815.     global _wwwHistory _wwwHpos
  816.     if {$_wwwHpos < [expr [llength $_wwwHistory] -1]} {
  817.         incr _wwwHpos
  818.         eval _wwwParseFile [lindex $_wwwHistory $_wwwHpos]
  819.     } else {
  820.         beep
  821.         message "Already at most recent document."
  822.     }
  823. }
  824.  
  825. proc wwwReload {} {
  826.     global _wwwHistory _wwwHpos
  827.     killWindow
  828.     eval _wwwParseFile [lindex $_wwwHistory $_wwwHpos]
  829. }
  830.  
  831. proc wwwBack {} {
  832.     global _wwwHistory _wwwHpos
  833.     if {$_wwwHpos > 0} {
  834.         incr _wwwHpos -1
  835.         eval _wwwParseFile [lindex $_wwwHistory $_wwwHpos]
  836.     } else {
  837.         beep
  838.         message "Already at first document."
  839.     }
  840. }
  841.  
  842. proc wwwSelectLink {} {
  843.     set link [wwwGetCurrentLink]
  844.     set link [_wwwHighlightLink [lindex $link 0]]
  845.     set p [getPos]
  846.     set q [selEnd]
  847.     select $p $p
  848.     select $p $q
  849.     wwwLink $link
  850. }
  851.  
  852. proc wwwEditLinkedDocument {} {
  853.     set to [_wwwHighlightLink [lindex [wwwGetCurrentLink] 0]]
  854.     if {[set l [string first ":" $to]] == -1} {
  855.         # it's local
  856.         _wwwSplit to "\#" pre
  857.         global wwwWhere
  858.         if {[string length $pre]} {
  859.             _wwwEditLinkedDoc "file://[file dirname $wwwWhere([win::Current])]/$pre"
  860.         } else {
  861.             _wwwEditLinkedDoc "file://$wwwWhere([win::Current])"
  862.         }
  863.         return
  864.     }
  865.     _wwwEditLinkedDoc $to
  866. }
  867.  
  868. proc _wwwEditLinkedDoc {to} {
  869.     set l [string first ":" $to]
  870.     set p [string trimleft [string range $to [expr $l +1] end] "/"]
  871.     _wwwMassagePath p
  872.     if {[catch {file::openQuietly $p}]} {
  873.         alertnote "Sorry, I can't edit and/or find that document."
  874.     }
  875. }
  876.  
  877. proc wwwModifyLink {} {
  878.     global mode
  879.     if {$mode != "WWW"} {
  880.         alertnote "Only useful in WWW browser mode."
  881.         return
  882.     }
  883.     
  884.     global _wwwHistory _wwwHpos
  885.     set f [lindex [lindex $_wwwHistory $_wwwHpos] 0]
  886.     if {![file exists $f]} {
  887.         alertnote "Sorry, I couldn't find that file!"
  888.     }
  889.     set w [win::Current]
  890.     if {![catch {getWinInfo -w $f i}]} {
  891.         if {$i(dirty)} {
  892.             message "Saving original file."
  893.             bringToFront $f
  894.             save
  895.             bringToFront $w
  896.         }
  897.     }
  898.     set link [wwwGetCurrentLink]
  899.     _wwwHighlightLink [lindex $link 0]
  900.     set p [getPos]
  901.     set q [selEnd]
  902.     regexp "\{ $p 15 \{wwwLink \"(\[^\"\]*)\"\} \} \{ $q 12 \}" [getColors] dmy link
  903.     set link "\"$link\""
  904.     set to [getline "Enter new link location" $link]
  905.     if {$to == "" || $to == $link} {
  906.         return
  907.     }
  908.     if {![regexp {^"} $to]} { set to "\"$to" }
  909.     if {![regexp {"$} $to]} { append to {"} }
  910.     set link [quote::Regfind $link]
  911.     set to [quote::Regsub $to]
  912.     set cid [open $f "r"]
  913.     if {[regsub -all -- $link [read $cid] $to out]} {
  914.         set ocid [open $f "w+"]
  915.         puts -nonewline $ocid $out
  916.         close $ocid
  917.         message "Updated original."
  918.     }
  919.     close $cid
  920.     if {![catch {bringToFront $f}]} {
  921.         message "Updating window to agree with disk version."
  922.         revert
  923.         bringToFront $w
  924.     }
  925.     setWinInfo read-only 0    
  926.     wwwMakeLink    $p $q $to
  927.     setWinInfo read-only 1    
  928. }
  929.  
  930. proc wwwUp {} {
  931.     set link [wwwGetCurrentLink]
  932.     _wwwHighlightLink [expr [lindex $link 1] -1]        
  933. }
  934.  
  935. proc wwwDown {} {
  936.     set link [wwwGetCurrentLink]
  937.     _wwwHighlightLink [expr [lindex $link 0] +1]        
  938. }
  939.  
  940. proc _wwwHighlightLink {l} {
  941.     global _wwwLinks
  942.     if {[set len [llength $_wwwLinks]] == 0} {return}
  943.     if {$l < 0 || $l >= $len} {
  944.         set l [expr ($l + $len) % $len]
  945.         beep
  946.     }
  947.     set link [lindex $_wwwLinks $l]
  948.     eval select $link
  949.     set p [getPos]
  950.     set q [selEnd]
  951.     regexp "\{ $p 15 \{wwwLink \"(\[^\"\]*)\"\} \} \{ $q 12 \}" [getColors] dmy link
  952.     message "Links to '$link'"
  953.     return $link
  954. }
  955.  
  956. proc wwwHighlightLink {l} {
  957.     global _wwwLinks
  958.     set _wwwLinks [_wwwGetLinks]
  959.     _wwwHighlightLink $l
  960. }
  961.  
  962. proc wwwGetCurrentLink {} {
  963.     global _wwwLinks
  964.     set _wwwLinks [_wwwGetLinks]
  965.     set p [getPos]
  966.     set i 0
  967.     while 1 {
  968.         if {[set j [lindex [lindex $_wwwLinks $i] 0]] == ""} {
  969.             return [list [expr $i-2] [expr $i-1]]
  970.         }
  971.         if {$p <= $j} {
  972.             if {$p == $j} {
  973.                 return [list $i $i]
  974.             } else {
  975.                 return [list [expr $i-1] $i]
  976.             }
  977.         }
  978.         incr i
  979.     }
  980.     incr i -1
  981.     return [list $i $i]
  982. }
  983.  
  984. proc wwwCopyLinkLocation {} {
  985.     alertnote "Unimplemented."
  986. }
  987.  
  988. proc _wwwGetLinks {} {
  989.     regsub -all {\{wwwLink "[^"]*"\} } [getColors] "" g
  990.     # remove all non 12,15 items
  991.     regsub -all {\{ [0-9]+ ([0-9]|1[0134]) \} ?} $g "" g
  992.     # remove superimposed links (caused by editing)
  993.     regsub -all {(\{ [0-9]+ 15 \} )+(\{ [0-9]+ 15 \} ?)} $g {\2} g
  994.     # convert 15-12 list pairs into single items
  995.     regsub -all { ([0-9]+) 15 \} \{ ([0-9]+) 12 } $g {\1 \2} g
  996.     # remove random left-overs items
  997.     regsub -all {\{ [0-9]+ 12 \} ?} $g "" g
  998.     return $g
  999. }
  1000.  
  1001.  
  1002.  
  1003.  
  1004.  
  1005.